unit uGHWVTsim ;

interface

uses
  Windows,        FMX.Objects,
  Menus,
  Graphics,
  SysUtils,
  Classes,
  Controls,
  Forms,
  FileCtrl,
  Math,
  Messages,
  VirtualTrees,
  uGHWReader,
  uPopupVisitor ;

type

  TGHWPathVisitor = class ;
  TGHWNameVisitor = class ;
  TGHWValueVisitor = class ;
  TGHWDrawVisitor = class ;

  TGHWVTSim = class( TVirtualDrawTree )
  private
    fPathVisitor : TGHWPathVisitor ;
    fNameVisitor : TGHWNameVisitor ;
    fValueVisitor : TGHWValueVisitor ;
    fDrawVisitor : TGHWDrawVisitor ;

    fPopupVisitorCol1 : TGHWPopupVisitorCol1 ;
    fPopupVisitorCol2 : TGHWPopupVisitorCol2 ;

    fHieRoot : TGHWHie ;
    fCenter : integer ;
    fMarker : integer ;
    fZoom : integer ;
    fOldOffsetX : integer ;
    fOldX : integer ;
    fInc : integer ;
    fDir : boolean ;
    fCol : array [ 0 .. 3 ] of TVirtualTreeColumn ;

    fEventTrack : TTrackMouseEvent ;

    procedure PaintNormalText( var PaintInfo : TVTPaintInfo ; TextOutFlags : integer ; Text : WideString ) ;
    procedure PaintDelta( var PaintInfo : TVTPaintInfo ) ;

    function GetZoom : integer ;
    procedure SetZoom( const Value : integer ) ;
    procedure SetRoot( const Value : TGHWHie ) ;
    procedure SetCenter( const Value : integer ) ;
    procedure SetMarker( const Value : integer ) ;
    function GetRangeLeft : integer ;
    function GetRangeRight : integer ;

    procedure HeaderDraw( Sender : TVTHeader ; HeaderCanvas : TCanvas ; column : TVirtualTreeColumn ; R : TRect ;
      Hover, Pressed : boolean ; DropMark : TVTDropMarkMode ) ;
    procedure HeaderDrawQueryElements( Sender : TVTHeader ; var PaintInfo : THeaderPaintInfo ;
      var Elements : THeaderPaintElements ) ;
    procedure AdvancedHeaderDraw( Sender : TVTHeader ; var PaintInfo : THeaderPaintInfo ;
      const Elements : THeaderPaintElements ) ;
    procedure BeforeCellPaint( Sender : TBaseVirtualTree ; TargetCanvas : TCanvas ; Node : PVirtualNode ;
      column : TColumnIndex ; CellPaintMode : TVTCellPaintMode ; CellRect : TRect ; var ContentRect : TRect ) ;
    // procedure DrawHint( Sender : TBaseVirtualTree ; HintCanvas : TCanvas ; Node : PVirtualNode ; R : TRect ;
    // column : TColumnIndex ) ;
    // procedure GetHintSize( Sender : TBaseVirtualTree ; Node : PVirtualNode ; column : TColumnIndex ; var R : TRect ) ;
  protected
    procedure DoPaintNode( var PaintInfo : TVTPaintInfo ) ; override ;
    procedure ValidateNodeDataSize( var Size : integer ) ; override ;

    procedure WMLButtonDown( var message : TWMLButtonDown ) ; message WM_LBUTTONDOWN ;
    procedure WMMouseMove( var message : TWMMouseMove ) ; message WM_MOUSEMOVE ;
    procedure WMMouseHover( var message : TWMMouseMove ) ; message WM_MOUSEHOVER ;

    procedure MyMouseDown( Button : TMouseButton ; Shift : TShiftState ; X, Y : integer ) ;
    procedure MyMouseMove( Shift : TShiftState ; X, Y : integer ) ;
    procedure MouseUp( Button : TMouseButton ; Shift : TShiftState ; X, Y : integer ) ; override ;
    procedure CMMouseWheel( var message : TCMMouseWheel ) ; message CM_MOUSEWHEEL ;

    procedure DrawDottedHLine( const PaintInfo : TVTPaintInfo ; Left, Right, Top : integer ) ; override ;
    procedure DrawDottedVLine( const PaintInfo : TVTPaintInfo ; Top, Bottom, Left : integer ) ; override ;

    function DoGetPopupMenu( Node : PVirtualNode ; column : TColumnIndex ; Position : TPoint ) : TPopupMenu ; override ;

    procedure ReInit ;
  public
    constructor Create( AOwner : TComponent ) ; override ;
    destructor Destroy ; override ;
    procedure Setup ;

  public
    property Center : integer read fCenter write SetCenter ;
    property Marker : integer read fMarker write SetMarker ;
    property HieRoot : TGHWHie read fHieRoot write SetRoot ;
    property Zoom : integer read GetZoom write SetZoom ;

    property RangeLeft : integer read GetRangeLeft ;
    property RangeRight : integer read GetRangeRight ;

  public
    procedure ZoomIn ;
    procedure ZoomOut ;
    procedure ZoomAll ;
    procedure ToBegin ;
    procedure ToEnd ;
    procedure ToLeft ;
    procedure ToRight ;
    procedure Plus ;
    procedure Minus ;

    procedure ShowAll ;
    procedure HideProcesses ;
    procedure HidePackages ;
    procedure HideSelected ;
    procedure HideInstances ;

    function ZoomEnabled : boolean ;
  end ;

  TGHWPathVisitor = class( TGHWVisitor )
  private
    fHieRoot : TGHWHie ;
    fViewer : TGHWVTSim ;
    fPaintInfo : TVTPaintInfo ;
    fIndex : integer ;
  public
    function Visit( Instance : TGHWHie ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieDesign ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieInstance ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateFor ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateIf ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalArray ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalRecord ) : TObject ; overload ; override ;
  end ;

  TGHWNameVisitor = class( TGHWVisitor )
  private
    fHieRoot : TGHWHie ;
    fViewer : TGHWVTSim ;
    fPaintInfo : TVTPaintInfo ;
    fIndex : integer ;
  public
    function Visit( Instance : TGHWHie ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieDesign ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieInstance ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateFor ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateIf ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalArray ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalRecord ) : TObject ; overload ; override ;
  end ;

  TGHWValueVisitor = class( TGHWVisitor )
  private
    fHieRoot : TGHWHie ;
    fViewer : TGHWVTSim ;
    fPaintInfo : TVTPaintInfo ;
    fIndex : integer ;
  public
    function Visit( Instance : TGHWHie ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieDesign ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieInstance ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateFor ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateIf ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalArray ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalRecord ) : TObject ; overload ; override ;
  end ;

  TGHWDrawVisitor = class( TGHWVisitor )
  private
    fHieRoot : TGHWHie ;
    fViewer : TGHWVTSim ;
    fPaintInfo : TVTPaintInfo ;
    fIndex : integer ;
    fDrawText : boolean ;
    procedure DrawMarkers ;
  public
    function Visit( Instance : TGHWHie ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieDesign ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieInstance ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateFor ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieGenerateIf ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWHieSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignal ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalArray ) : TObject ; overload ; override ;
    function Visit( Instance : TGHWSignalRecord ) : TObject ; overload ; override ;
  end ;

  PTreeData = ^TTreeData ;

  TTreeData = record
    aObject : TGHW ;
    aIndex : integer ;
  end ;

var
  fs_per_pixel : int64 = 1000000 ;

implementation

function Min( a, b : integer ) : integer ;
begin
  if a < b then
    Result := a
  else
    Result := b ;
end ;

function Max( a, b : integer ) : integer ;
begin
  if a > b then
    Result := a
  else
    Result := b ;
end ;

{ TGHWVTSim }

procedure TGHWVTSim.HeaderDraw( Sender : TVTHeader ; HeaderCanvas : TCanvas ; column : TVirtualTreeColumn ; R : TRect ;
  Hover, Pressed : boolean ; DropMark : TVTDropMarkMode ) ;
var
  i : integer ;
  p : TPoint ;
begin
  if column <> fCol[ 3 ] then
    Exit ;

  R.Top := R.Top + 3 ;
  HeaderCanvas.Brush.Style := bsClear ;
  for i := RangeLeft to RangeRight do begin
    R.Left := R.Left + 1000000 * fZoom div fs_per_pixel ;
    R.Right := R.Left + 1000000 * fZoom div fs_per_pixel ;
    if ( R.Right <= ClientRect.Right ) and ( R.Right <= column.Left + column.Width ) and ( R.Left < ClientRect.Right )
    then begin
      case i mod 10 of
        0 : begin
            p := Point( R.Left + Margin - fZoom, R.Top ) ;
            if ( Zoom > 1 ) or ( i = RangeLeft ) or ( i = RangeRight ) then
              HeaderCanvas.TextOut( p.X + 3, p.Y - 3, IntToStr( i ) ) ;
          end ;
        5 :
          if Zoom > 1 then
            p := Point( R.Left + Margin - fZoom, R.Top + 5 ) ;
      else
        if Zoom > 3 then
          p := Point( R.Left + Margin - fZoom, R.Top + 7 ) ;
      end ;
      HeaderCanvas.MoveTo( p.X, p.Y + 4 ) ;
      HeaderCanvas.LineTo( p.X, R.Top + 14 ) ;
    end ;
  end ;
end ;

procedure TGHWVTSim.AdvancedHeaderDraw( Sender : TVTHeader ; var PaintInfo : THeaderPaintInfo ;
  const Elements : THeaderPaintElements ) ;
begin
  if hpeBackground in Elements then
    with PaintInfo do begin
      TargetCanvas.Brush.Style := bsSolid ;
      TargetCanvas.Brush.Color := clBtnFace ;
      TargetCanvas.FillRect( PaintRectangle ) ;
      HeaderDraw( Sender, TargetCanvas, column, PaintRectangle, false, false, dmmNone ) ;
    end ;
end ;

procedure TGHWVTSim.HeaderDrawQueryElements( Sender : TVTHeader ; var PaintInfo : THeaderPaintInfo ;
  var Elements : THeaderPaintElements ) ;
begin
  Elements := [ hpeBackground, hpeHeaderGlyph ] ;
end ;

procedure TGHWVTSim.ShowAll ;
var
  iNode, iNode2 : PVirtualNode ;
begin
  iNode := GetFirst ;
  while iNode <> nil do begin
    if vsFiltered in iNode.States then
      DoCheckClick( iNode, csCheckedNormal ) ;
    iNode2 := GetNext( iNode ) ;
    if iNode2 = iNode then
      break ;
    iNode := iNode2 ;
  end ;
  TreeOptions.PaintOptions := TreeOptions.PaintOptions + [ toShowFilteredNodes ] ;
end ;

procedure TGHWVTSim.HidePackages ;
var
  iNode : PVirtualNode ;
  iData : PTreeData ;
begin
  iNode := GetFirst ;
  while iNode <> nil do begin
    iData := GetNodeData( iNode ) ;
    if assigned( iData ) and assigned( iData.aObject ) then begin
      if iData.aObject is TGHWHiePackage then
        DoCheckClick( iNode, csCheckedNormal ) ;
    end ;
    iNode := GetNext( iNode ) ;
  end ;
end ;

procedure TGHWVTSim.HideInstances ;
var
  iNode, iChild : PVirtualNode ;
  iData : PTreeData ;
  flag : boolean ;
begin
  iNode := GetFirst ;
  while iNode <> nil do begin
    iData := GetNodeData( iNode ) ;
    if assigned( iData ) and assigned( iData.aObject ) then begin
      if iData^.aObject is TGHWHieInstance then begin
        flag := false ;
        iChild := iNode^.FirstChild ;
        while iChild <> nil do begin
          iData := GetNodeData( iChild ) ;
          flag := flag or ( iData^.aObject is TGHWHieInstance ) ;
          iChild := iChild^.NextSibling ;
        end ;
        if not flag then
          DoCheckClick( iNode, csCheckedNormal ) ;
      end ;
    end ;
    iNode := GetNext( iNode ) ;
  end ;
end ;

procedure TGHWVTSim.HideProcesses ;
var
  iNode : PVirtualNode ;
  iData : PTreeData ;
begin
  iNode := GetFirst ;
  while iNode <> nil do begin
    iData := GetNodeData( iNode ) ;
    if assigned( iData ) and assigned( iData.aObject ) then begin
      if iData.aObject is TGHWHieProcess then
        DoCheckClick( iNode, csCheckedNormal ) ;
    end ;
    iNode := GetNext( iNode ) ;
  end ;
end ;

procedure TGHWVTSim.HideSelected ;
var
  iNode : PVirtualNode ;
begin
  iNode := GetFirstChecked ;
  while iNode <> nil do begin
    Include( iNode.States, vsFiltered ) ;
    iNode := GetNextChecked( iNode ) ;
  end ;

  iNode := GetFirstChecked( csUncheckedNormal ) ;
  while iNode <> nil do begin
    Exclude( iNode.States, vsFiltered ) ;
    iNode := GetNextChecked( iNode, csUncheckedNormal ) ;
  end ;

  iNode := GetFirstChecked( csMixedPressed ) ;
  while iNode <> nil do begin
    Exclude( iNode.States, vsFiltered ) ;
    iNode := GetNextChecked( iNode, csMixedPressed ) ;
  end ;

  TreeOptions.PaintOptions := TreeOptions.PaintOptions - [ toShowFilteredNodes ] ;
  Invalidate ;
end ;

constructor TGHWVTSim.Create( AOwner : TComponent ) ;
begin
  inherited ;
  Align := alClient ;
  Hint := 'Simulation View' ;
  Colors.GridLineColor := clGray ;
  Colors.BorderColor := clWhite ;
  Font.name := 'Consolas' ;
  Font.Size := 8 ;

  Linemode := lmBands ;
  TreeOptions.PaintOptions := TreeOptions.PaintOptions + //
    [ toShowHorzGridLines, toShowVertGridLines, toShowRoot, toShowBackground ] - [ ] ;
  TreeOptions.MiscOptions := TreeOptions.MiscOptions + //
    [ toFullRepaintOnResize, toGridExtensions, toReportMode, toCheckSupport, toWheelPanning ] - [ ] ;
  TreeOptions.SelectionOptions := TreeOptions.SelectionOptions + //
    [ toMultiSelect, toFullRowSelect ] - [ ] ;
  TreeOptions.AnimationOptions := TreeOptions.AnimationOptions + //
    [ toAnimatedToggle ] - [ ] ;
  TreeOptions.AutoOptions := TreeOptions.AutoOptions + //
    [ toAutoScroll, toAutoScrollOnExpand, toAutoChangeScale ] - [ ] ;
  NodeDataSize := -1 ;

  ScrollbarOptions.AlwaysVisible := True ;

  fZoom := 4 ;

  fPathVisitor := TGHWPathVisitor.Create ;
  fPathVisitor.fViewer := Self ;
  fNameVisitor := TGHWNameVisitor.Create ;
  fNameVisitor.fViewer := Self ;
  fValueVisitor := TGHWValueVisitor.Create ;
  fValueVisitor.fViewer := Self ;
  fDrawVisitor := TGHWDrawVisitor.Create ;
  fDrawVisitor.fViewer := Self ;

  fPopupVisitorCol1 := TGHWPopupVisitorCol1.Create ;
  fPopupVisitorCol1.Viewer := Self ;

  fPopupVisitorCol2 := TGHWPopupVisitorCol2.Create ;
  fPopupVisitorCol2.Viewer := Self ;

  fCenter := 0 ;
  fMarker := 0 ;

  HintMode := hmHint ;
  ShowHint := True ;

  CheckImageKind := ckLightTick ;

  // OnDrawHint := DrawHint ;
  // OnGetHintSize := GetHintSize ;

  Colors.FocusedSelectionColor := clWebAzure ;
  Colors.FocusedSelectionBorderColor := clWebPaleTurquoise ;
end ;

procedure TGHWVTSim.Setup ;
begin
  with Header do begin
    AutoSizeIndex := 0 ;
    DefaultHeight := 20 ;
    Font.name := 'Tahoma' ;
    Options := [ hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible, hoOwnerDraw ] ;

    fCol[ 0 ] := Columns.Add ;
    with fCol[ 0 ] do begin
      Options := [ coEnabled, coParentBidiMode, coParentColor, coResizable, //
        coVisible, coFixed, coUseCaptionAlignment ] ;
      Position := 0 ;
      Text := 'Path' ;
      Alignment := taRightJustify ;
      Width := 150 ;
    end ;

    fCol[ 1 ] := Columns.Add ;
    with fCol[ 1 ] do begin
      Options := [ coEnabled, coParentBidiMode, coParentColor, coResizable, //
        coVisible, coFixed, coAllowFocus, coUseCaptionAlignment ] ;
      Position := 1 ;
      Text := 'Signal' ;
      Alignment := taLeftJustify ;
      Width := 200 ;
    end ;

    fCol[ 2 ] := Columns.Add ;
    with fCol[ 2 ] do begin
      Options := [ coEnabled, coParentBidiMode, coParentColor, coResizable, //
        coVisible, coFixed, coUseCaptionAlignment ] ;
      Position := 2 ;
      Text := 'Value at Cursor' ;
      Alignment := taRightJustify ;
      Width := 150 ;
    end ;

    fCol[ 3 ] := Columns.Add ;
    with fCol[ 3 ] do begin
      Options := [ coEnabled, coParentBidiMode, coParentColor, //
        coVisible, coUseCaptionAlignment ] ;
      Width := 0 ;
      MaxWidth := MAXINT ;
      MinWidth := 0 ;
      Style := vsOwnerDraw ;
    end ;

    // Style := hsXPStyle ;
    MainColumn := 1 ;
  end ;
  OnHeaderDraw := HeaderDraw ;
  OnHeaderDrawQueryElements := HeaderDrawQueryElements ;
  OnAdvancedHeaderDraw := AdvancedHeaderDraw ;
  OnBeforeCellPaint := BeforeCellPaint ;

  fEventTrack.cbSize := sizeof( fEventTrack ) ;
  fEventTrack.dwFlags := TME_HOVER ;
  fEventTrack.hwndTrack := Handle ;
  fEventTrack.dwHoverTime := 10 ;
end ;

destructor TGHWVTSim.Destroy ;
begin
  fPopupVisitorCol2.Free ;
  fPopupVisitorCol1.Free ;
  fPathVisitor.Free ;
  fNameVisitor.Free ;
  fValueVisitor.Free ;
  fDrawVisitor.Free ;
  inherited ;
end ;

// procedure TGHWVTSim.DrawHint( Sender : TBaseVirtualTree ; HintCanvas : TCanvas ; Node : PVirtualNode ; R : TRect ;
// column : TColumnIndex ) ;
// var
// Data : PTreeData ;
// DrawFormat : Cardinal ;
// iText : string ;
// iSig : TGHWSignal ;
// begin
// if ( column in [ 1 .. 2 ] ) and assigned( Node ) then begin
// Data := GetNodeData( Node ) ;
// if assigned( Data ) then begin
// iText := Data^.aObject.Hint[ column ] ;
// with HintCanvas do begin
// Font.Color := clInfoText ;
// Pen.Color := clBlack ;
// Brush.Color := clInfoBk ;
// Rectangle( R ) ;
// InflateRect( R, -2, -2 ) ;
// DrawFormat := DT_LEFT or DT_NOPREFIX ;
// SetBkMode( Handle, Windows.TRANSPARENT ) ;
// Windows.DrawTextW( Handle, PWideChar( iText ), Length( iText ), R, DrawFormat )
// end ;
// end ;
// end ;
// end ;
//
// procedure TGHWVTSim.GetHintSize( Sender : TBaseVirtualTree ; Node : PVirtualNode ; column : TColumnIndex ;
//
// var R : TRect ) ;
// begin
// if ( column in [ 1 .. 2 ] ) and assigned( Node ) then begin
// R.Right := 300 ;
// R.Bottom := 5 * Node^.NodeHeight ;
// end ;
// end ;

procedure TGHWVTSim.SetCenter( const Value : integer ) ;
begin
  if fCenter <> Value then begin
    if ( RangeLeft <= Value ) and ( Value < RangeRight ) then begin
      fCenter := Value ;
      Invalidate ;
    end ;
  end ;
end ;

procedure TGHWVTSim.SetMarker( const Value : integer ) ;
begin
  if fMarker <> Value then begin
    if ( RangeLeft <= Value ) and ( Value < RangeRight ) then begin
      fMarker := Value ;
      Invalidate ;
    end ;
  end ;
end ;

procedure TGHWVTSim.SetRoot( const Value : TGHWHie ) ;
begin
  Clear ;
  fHieRoot := Value ;
  Center := 0 ;
  Marker := 0 ;

  fCol[ 3 ].Width := ( RangeRight - RangeLeft ) * Zoom ;

  if assigned( fPathVisitor ) then
    fPathVisitor.fHieRoot := Value ;
  if assigned( fNameVisitor ) then
    fNameVisitor.fHieRoot := Value ;
  if assigned( fValueVisitor ) then
    fValueVisitor.fHieRoot := Value ;
  if assigned( fDrawVisitor ) then
    fDrawVisitor.fHieRoot := Value ;
  ReInit ;
end ;

procedure TGHWVTSim.ReInit ;
  procedure SignalProc( aSignal : TGHWSignal ; aNode : PVirtualNode ) ;
  var
    iNode : PVirtualNode ;
    iData : PTreeData ;
    i : integer ;
  begin
    for i := 0 to aSignal.Count - 1 do begin
      iNode := AddChild( aNode ) ;
      iData := GetNodeData( iNode ) ;
      iData^.aObject := aSignal[ i ] ;
      iData^.aIndex := i ;
      Expanded[ iNode ] := True ;

      if aSignal[ i ].Count > 0 then
        SignalProc( aSignal[ i ], iNode ) ;
      iNode.CheckType := ctTriStateCheckBox ;
    end ;
  end ;

  procedure ChildProc( aChild : TGHWHie ; aNode : PVirtualNode ) ;
  var
    iNode : PVirtualNode ;
    iData : PTreeData ;
    i : integer ;
  begin
    i := 0 ;

    while assigned( aChild ) do begin
      iNode := AddChild( aNode ) ;
      iData := GetNodeData( iNode ) ;
      iData^.aObject := aChild ;
      iData^.aIndex := i ;
      Inc( i ) ;
      if aChild is TGHWHieProcess then begin
        Include( iNode.States, vsFiltered ) ;
      end ;
      if aChild is TGHWHiePackage then begin
        Include( iNode.States, vsFiltered ) ;
      end ;

      if assigned( aChild.Child ) then
        ChildProc( aChild.Child, iNode ) ;

      if assigned( aChild.Signals ) then
        SignalProc( aChild.Signals, iNode ) ;

      Expanded[ iNode ] := false ;
      if aNode = nil then
        Expanded[ iNode ] := True ;
      iNode.CheckType := ctTriStateCheckBox ;

      if aChild is TGHWHieInstance then
        Expanded[ iNode ] := True ;
      aChild := aChild.Brother ;
    end ;
  end ;

begin
  BeginUpdate ;
  try
    ChildProc( fHieRoot, nil ) ;
  finally
    EndUpdate ;
    ShowAll ;
    Invalidate ;
  end ;
end ;

procedure TGHWVTSim.ZoomOut ;
begin
  if fZoom > 1 then
    Zoom := fZoom - 1 ;
end ;

procedure TGHWVTSim.ZoomAll ;
begin
  Zoom := 1 ;
  Center := 0 ;
end ;

function TGHWVTSim.ZoomEnabled : boolean ;
begin
  Result := assigned( HieRoot ) ;
end ;

procedure TGHWVTSim.ZoomIn ;
begin
  if fZoom < 16 then
    Zoom := fZoom + 1 ;
end ;

function TGHWVTSim.DoGetPopupMenu( Node : PVirtualNode ; column : TColumnIndex ; Position : TPoint ) : TPopupMenu ;
var
  iData : PTreeData ;
begin
  Result := nil ;
  if assigned( Node ) then begin
    iData := GetNodeData( Node ) ;
    if assigned( iData ) and assigned( iData^.aObject ) then begin
      case column of
        1 : begin
            fPopupVisitorCol1.Viewer := Self ;
            Result := TPopupMenu( iData^.aObject.Accept( fPopupVisitorCol1 ) ) ;
          end ;
        2 : begin
            fPopupVisitorCol2.Viewer := Self ;
            Result := TPopupMenu( iData^.aObject.Accept( fPopupVisitorCol2 ) ) ;
          end ;
      end ;
    end ;
  end ;
end ;

procedure TGHWVTSim.PaintDelta( var PaintInfo : TVTPaintInfo ) ;
var
  R, rt : TRect ;
  cx : integer ;
  s : string ;
begin
  with PaintInfo do begin
    R := ContentRect ;

    // draw dimension line
    if Center < Marker then begin
      Canvas.Pen.Color := clGray ;
      Canvas.MoveTo( R.Left + ( Center - RangeLeft ) * Zoom + 2, R.Top + 6 ) ;
      Canvas.LineTo( R.Left + ( Marker - RangeLeft ) * Zoom - 2, R.Top + 6 ) ;
    end
    else if Center > Marker then begin
      Canvas.Pen.Color := clGray ;
      Canvas.MoveTo( R.Left + ( Marker - RangeLeft ) * Zoom + 2, R.Top + 6 ) ;
      Canvas.LineTo( R.Left + ( Center - RangeLeft ) * Zoom - 2, R.Top + 6 ) ;
    end
    else
      Exit ;

    // paint text
    rt := R ;
    rt.Left := R.Left + ( ( Marker + Center ) div 2 - RangeLeft ) * Zoom ;
    s := ' ' + IntToStr( Marker - Center ) + ' ' ;
    Canvas.Font.Color := clBlue ;
    cx := Canvas.TextExtent( s ).cx ;
    rt.Right := rt.Left + cx div 2 ;
    rt.Left := rt.Left - cx div 2 ;
    if abs( Marker - Center ) * Zoom < cx then
      OffsetRect( rt, cx, 0 ) ;
    Canvas.TextRect( rt, rt.Left, rt.Top + 2, s ) ;
  end ;
end ;

{ TVTPaintInfo = record
  Canvas: TCanvas;           // the canvas to paint on
  PaintOptions: TVTInternalPaintOptions;  // a copy of the paint options passed to PaintTree
  Node: PVirtualNode;        // the node to paint
  Column: TColumnIndex;      // the node's column index to paint
  Position: TColumnPosition; // the column position of the node
  CellRect,                  // the node cell
  ContentRect: TRect;        // the area of the cell used for the node's content
  NodeWidth: Integer;        // the actual node width
  Alignment: TAlignment;     // how to align within the node rectangle
  BidiMode: TBidiMode;       // directionality to be used for painting
  BrushOrigin: TPoint;       // the alignment for the brush used to draw dotted lines
  ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image
  end; }

procedure TGHWVTSim.DoPaintNode( var PaintInfo : TVTPaintInfo ) ;
var
  Data : PTreeData ;
begin
  with PaintInfo do
    if assigned( Node ) then begin
      Data := GetNodeData( Node ) ;
      if assigned( Data ) then begin
        case PaintInfo.column of
          0 : begin
              fPathVisitor.fPaintInfo := PaintInfo ;
              fPathVisitor.fIndex := Data.aIndex ;
              if assigned( Data^.aObject ) then
                Data^.aObject.Accept( fPathVisitor ) ;
            end ;
          1 : begin
              fNameVisitor.fPaintInfo := PaintInfo ;
              fNameVisitor.fIndex := Data.aIndex ;
              if assigned( Data^.aObject ) then
                Data^.aObject.Accept( fNameVisitor ) ;
            end ;
          2 : begin
              fValueVisitor.fPaintInfo := PaintInfo ;
              fValueVisitor.fIndex := Data.aIndex ;
              if assigned( Data^.aObject ) then
                Data^.aObject.Accept( fValueVisitor ) ;
            end ;
          3 : begin
              fDrawVisitor.fPaintInfo := PaintInfo ;
              fDrawVisitor.fIndex := Data.aIndex ;
              fDrawVisitor.fDrawText := True ;
              if assigned( Data^.aObject ) then
                Data^.aObject.Accept( fDrawVisitor ) ;
            end ;
        end ;
      end ;
    end ;
end ;

procedure TGHWVTSim.BeforeCellPaint( Sender : TBaseVirtualTree ; TargetCanvas : TCanvas ; Node : PVirtualNode ;
  column : TColumnIndex ; CellPaintMode : TVTCellPaintMode ; CellRect : TRect ;

  var ContentRect : TRect ) ;
var
  Data : PTreeData ;
begin
  if column <> 1 then
    Exit ;

  if not( vsSelected in Node.States ) then
    with TargetCanvas do begin
      Brush.Style := bsSolid ;
      if assigned( Node ) then begin
        Data := GetNodeData( Node ) ;
        if assigned( Data ) and assigned( Data^.aObject ) then begin
          if Data^.aObject is TGHWSignal then
            Brush.Color := clWebSeashell
          else if Data^.aObject is TGHWHiePort then
            Brush.Color := clWebMintcream
          else if Data^.aObject is TGHWHieSignal then
            Brush.Color := clWebSeashell
          else if Data^.aObject is TGHWHieInstance then
            Brush.Color := clWebSkyBlue
          else if Data^.aObject is TGHWHieBlock then
            Brush.Color := clWebPowderBlue
          else
            Exit ;
          FillRect( CellRect ) ;
        end ;
      end ;
    end ;
end ;

procedure TGHWVTSim.PaintNormalText( var PaintInfo : TVTPaintInfo ; TextOutFlags : integer ; Text : WideString ) ;
const
  AlignmentToDrawFlag : array [ TAlignment ] of Cardinal = ( DT_LEFT, DT_RIGHT, DT_CENTER ) ;
var
  R : TRect ;
  DrawFormat : Cardinal ;
begin
  with PaintInfo do begin
    // Set default font values first.
    Canvas.Font := Font ;
    R := ContentRect ;
    Canvas.TextFlags := 0 ;

    // Multiline nodes don't need special font handling or text manipulation.
    // Note: multiline support requires the Unicode version of DrawText, which is able to do word breaking.
    // The emulation in this unit does not support this so we have to use the OS version. However
    // DrawTextW is only available on NT/2000/XP and up. Hence there is only partial multiline support
    // for 9x/Me.
    if vsMultiline in Node.States then begin
      InflateRect( R, -TextMargin, 0 ) ;
      // DoPaintText( Node, Canvas, Column, ttNormal ) ;
      // Disabled node color overrides all other variants.
      if ( vsDisabled in Node.States ) or not Enabled then
        Canvas.Font.Color := Colors.DisabledColor ;

      // The edit control flag will ensure that no partial line is displayed, that is, only lines
      // which are (vertically) fully visible are drawn.
      DrawFormat := DT_NOPREFIX or DT_WORDBREAK or DT_END_ELLIPSIS or DT_EDITCONTROL or
        AlignmentToDrawFlag[ Alignment ] ;
      if BidiMode <> bdLeftToRight then
        DrawFormat := DrawFormat or DT_RTLREADING ;
    end
    else begin
      InflateRect( R, -TextMargin, 0 ) ;
      // Disabled node color overrides all other variants.
      if ( vsDisabled in Node.States ) or not Enabled then
        Canvas.Font.Color := Colors.DisabledColor ;

      DrawFormat := DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE ;
      if BidiMode <> bdLeftToRight then
        DrawFormat := DrawFormat or DT_RTLREADING ;
      // Check if the text must be shortend.
      if ( column > -1 ) and ( ( NodeWidth - 2 * TextMargin ) > R.Right - R.Left ) then begin
        if Alignment = taRightJustify then
          DrawFormat := DrawFormat or DT_RIGHT
        else
          DrawFormat := DrawFormat or DT_LEFT ;
      end
      else
        DrawFormat := DrawFormat or AlignmentToDrawFlag[ Alignment ] ;
    end ;

    if Canvas.TextFlags and ETO_OPAQUE = 0 then
      SetBkMode( Canvas.Handle, TRANSPARENT )
    else
      SetBkMode( Canvas.Handle, OPAQUE ) ;
    // if ( Win32Platform and VER_PLATFORM_WIN32_NT ) <> 0 then
    // Windows.DrawText( Canvas.Handle, PWideChar( Text ), Length( Text ), R, DrawFormat )
    // else
    DrawText( Canvas.Handle, PWideChar( Text ), Length( Text ), R, DrawFormat ) ;
  end ;
end ;

procedure TGHWVTSim.ValidateNodeDataSize( var Size : integer ) ;
begin
  Size := sizeof( TTreeData ) ;
end ;

function TGHWVTSim.GetRangeLeft : integer ;
begin
  Result := 0 ;
  if assigned( fHieRoot ) then
    Result := fHieRoot.Oldest div fs_per_pixel ;
end ;

function TGHWVTSim.GetRangeRight : integer ;
begin
  Result := 0 ;
  if assigned( fHieRoot ) then
    Result := fHieRoot.Newest div fs_per_pixel + 4 ;
end ;

function TGHWVTSim.GetZoom : integer ;
begin
  Result := fZoom ;
end ;

procedure TGHWVTSim.SetZoom( const Value : integer ) ;
begin
  fZoom := Value ;
  fCol[ 3 ].Width := ( RangeRight - RangeLeft ) * Zoom ;
  Invalidate ;
end ;

procedure TGHWVTSim.Minus ;
var
  iRange : int64 ;
begin
  if assigned( fHieRoot ) then begin
    iRange := ( fHieRoot.Newest - fHieRoot.Oldest ) div fs_per_pixel ;
    if Center >= iRange div 16 div Zoom then
      Center := Center - iRange div 16 div Zoom
    else
      Center := 0 ;
  end ;
end ;

procedure TGHWVTSim.ToBegin ;
begin
  if assigned( fHieRoot ) then
    Center := fHieRoot.Oldest div fs_per_pixel ;
end ;

procedure TGHWVTSim.ToLeft ;
var
  iRange : int64 ;
begin
  if assigned( fHieRoot ) then begin
    iRange := ( fHieRoot.Newest - fHieRoot.Oldest ) div fs_per_pixel ;
    if Center >= iRange div 64 div Zoom then
      Center := Center - iRange div 64 div Zoom
    else
      Center := 0 ;
  end ;
end ;

procedure TGHWVTSim.Plus ;
var
  iRange : int64 ;
begin
  if assigned( fHieRoot ) then begin
    iRange := ( fHieRoot.Newest - fHieRoot.Oldest ) div fs_per_pixel ;
    if Center + iRange div 16 div Zoom < fHieRoot.Newest div fs_per_pixel then
      Center := Center + iRange div 16 div Zoom
    else
      Center := fHieRoot.Newest div fs_per_pixel ;
  end ;
end ;

procedure TGHWVTSim.ToRight ;
var
  iRange : int64 ;
begin
  if assigned( fHieRoot ) then begin
    iRange := ( fHieRoot.Newest - fHieRoot.Oldest ) div fs_per_pixel ;
    if Center + iRange div 64 div Zoom < fHieRoot.Newest div fs_per_pixel then
      Center := Center + iRange div 64 div Zoom
    else
      Center := fHieRoot.Newest div fs_per_pixel ;
  end ;
end ;

procedure TGHWVTSim.ToEnd ;
begin
  if assigned( fHieRoot ) then
    Center := fHieRoot.Newest div fs_per_pixel ;
end ;

procedure TGHWVTSim.CMMouseWheel( var message : TCMMouseWheel ) ;
var
  iViewLeft, X : integer ;
begin
  fOldOffsetX := OffsetX ;
  iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
  if message.XPos > iViewLeft then begin
    X := iViewLeft - OffsetX ;
    if ( ssCtrl in message.ShiftState ) and ( ssShift in message.ShiftState ) then begin
      X := X div fZoom ;
      fZoom := fZoom + sign( message.WheelDelta ) ;
      if fZoom < 1 then
        Zoom := 1
      else if Zoom > 16 then
        Zoom := 16
      else
        Zoom := fZoom ;
      message.Result := 1 ;
      X := X * fZoom ;
      OffsetX := iViewLeft - X ;
    end
    else if ssCtrl in message.ShiftState then begin
      Center := Center - sign( message.WheelDelta ) * 64 div Zoom ;
      message.Result := 1 ;
    end
    else if ssShift in message.ShiftState then begin
      Marker := Marker - sign( message.WheelDelta ) * 64 div Zoom ;
      message.Result := 1 ;
    end
    else begin
      OffsetX := fOldOffsetX + sign( message.WheelDelta ) * 256 div Zoom ;
      message.Result := 1 ;
    end ;
  end
  else
    inherited ;
end ;

procedure TGHWVTSim.WMLButtonDown( var message : TWMLButtonDown ) ;
var
  iViewLeft : integer ;
begin
  iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
  if message.XPos > iViewLeft then
    MyMouseDown( mbLeft, KeysToShiftState( message.Keys ), message.XPos, message.YPos )
  else
    inherited ;
end ;

procedure TGHWVTSim.MyMouseDown( Button : TMouseButton ; Shift : TShiftState ; X, Y : integer ) ;
var
  iViewLeft : integer ;
begin
  fOldOffsetX := OffsetX ;
  fOldX := X ;
  fInc := 1 ;

  if ssLeft in Shift then begin
    iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
    if X > iViewLeft then begin
      if ( ssShift in Shift ) and ( ssCtrl in Shift ) then
        Exit
      else if ssCtrl in Shift then begin
        Center := ( X - fCol[ 3 ].Left - fCol[ 3 ].Margin ) div Zoom ;
      end
      else if ssShift in Shift then begin
        Marker := ( X - fCol[ 3 ].Left - fCol[ 3 ].Margin ) div Zoom ;
      end
      else begin
        Cursor := crHandPoint ;
      end ;
    end ;
  end
  else
    inherited ;
end ;

procedure TGHWVTSim.WMMouseHover( var message : TWMMouseMove ) ;
var
  iViewLeft : integer ;
begin
  iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
  if message.XPos > iViewLeft then
    MyMouseMove( KeysToShiftState( message.Keys ), message.XPos, message.YPos )
end ;

procedure TGHWVTSim.WMMouseMove( var message : TWMMouseMove ) ;
var
  iViewLeft : integer ;
begin
  iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
  if message.XPos > iViewLeft then
    MyMouseMove( KeysToShiftState( message.Keys ), message.XPos, message.YPos )
  else
    inherited ;
end ;

procedure TGHWVTSim.MyMouseMove( Shift : TShiftState ; X, Y : integer ) ;
var
  iViewLeft, iViewRight : integer ;

  procedure Scroll ;
  var
    iLeft, iRight : integer ;
  begin
    TrackMouseEvent( fEventTrack ) ;
    iLeft := ( 5 * iViewLeft + iViewRight ) div 6 ;
    iRight := ( iViewLeft + 5 * iViewRight ) div 6 ;
    if X < iLeft then begin
      if fDir then begin
        fDir := false ;
        fOldOffsetX := OffsetX ;
        fInc := 1 ;
      end ;
      OffsetX := fOldOffsetX - fInc ;
      Inc( fInc, ( X - iLeft ) div 2 ) ;
    end ;
    if X > iRight then begin
      if not fDir then begin
        fDir := True ;
        fOldOffsetX := OffsetX ;
        fInc := 1 ;
      end ;
      OffsetX := fOldOffsetX + fInc ;
      Inc( fInc, ( iRight - X ) div 2 ) ;
    end ;
  end ;

begin
  if ssLeft in Shift then begin
    iViewLeft := fCol[ 0 ].Width + fCol[ 1 ].Width + fCol[ 2 ].Width ;
    iViewRight := ClientRect.Right ;
    if X > iViewLeft then begin
      if ( ssShift in Shift ) and ( ssCtrl in Shift ) then
        Scroll
      else if ssCtrl in Shift then begin
        Center := ( X - fCol[ 3 ].Left - fCol[ 3 ].Margin ) div Zoom ;
        Scroll ;
      end
      else if ssShift in Shift then begin
        Marker := ( X - fCol[ 3 ].Left - fCol[ 3 ].Margin ) div Zoom ;
        Scroll ;
      end
      else begin
        OffsetX := fOldOffsetX + X - fOldX ;
      end ;
    end ;
  end
  else
    inherited ;
end ;

procedure TGHWVTSim.MouseUp( Button : TMouseButton ; Shift : TShiftState ; X, Y : integer ) ;
begin
  inherited ;
  Cursor := crDefault ;
end ;

var
  gName : string ;

procedure TGHWVTSim.DrawDottedHLine( const PaintInfo : TVTPaintInfo ; Left, Right, Top : integer ) ;
begin
  with PaintInfo, Canvas do begin
    Pen.Color := TColor( $E0E0E0 ) ;
    MoveTo( Left, Top ) ;
    LineTo( Right, Top ) ;
  end ;
end ;

// ----------------------------------------------------------------------------------------------------------------------

procedure TGHWVTSim.DrawDottedVLine( const PaintInfo : TVTPaintInfo ; Top, Bottom, Left : integer ) ;
begin
  with PaintInfo, Canvas do begin
    Pen.Color := TColor( $E0E0E0 ) ;
    MoveTo( Left, Top ) ;
    LineTo( Left, Bottom ) ;
  end ;
end ;

{ TGHWDrawVisitor }

function TGHWDrawVisitor.Visit( Instance : TGHWSignal ) : TObject ;
type
  // glyph indices
  TSigGlyph = ( //
    hl, lh, hh, zl, lz, zz, ll, bb, //
    zh, hz, zb, bz, lb, bl, hb, bh, //
    zu, uu, uz, ub, bu, lu, ul, hu, //
    uh ) ;

var
  i : integer ;
  n, o : TSLVType ;
  g : TSigGlyph ;
  rt : TRect ;
  Zoom : integer ;
  iTypeEnum : TGHWTypeEnum ;
  iStart, iEnd : integer ;
  iLeft, iRight : int64 ;

  procedure Draw( g : TSigGlyph ) ;
  var
    l, R, t, b, m : integer ;

    procedure Line( y1, y2 : integer ) ;
    begin
      with fPaintInfo.Canvas do begin
        MoveTo( l, y1 ) ;
        LineTo( R, y2 ) ;
      end ;
    end ;

    procedure rArrow( y0, y1, y2 : integer ) ;
    begin
      with fPaintInfo.Canvas do begin
        MoveTo( l, y0 ) ;
        LineTo( R, y2 ) ;
        MoveTo( l, y1 ) ;
        LineTo( R, y2 ) ;
      end ;
    end ;

    procedure lArrow( y0, y1, y2 : integer ) ;
    begin
      with fPaintInfo.Canvas do begin
        MoveTo( R, y1 ) ;
        LineTo( l, y0 ) ;
        LineTo( R, y2 ) ;
      end ;
    end ;

    procedure Lines( y0, y1, y2, y3 : integer ) ;
    begin
      with fPaintInfo.Canvas do begin
        MoveTo( l, y0 ) ;
        LineTo( R, y1 ) ;
        MoveTo( l, y2 ) ;
        LineTo( R, y3 ) ;
      end ;
    end ;

  begin
    l := rt.Left ;
    R := rt.Right ;

    t := rt.Top + 2 ;
    m := ( rt.Top + rt.Bottom ) div 2 ;
    b := rt.Bottom - 3 ;

    case g of
      bb :
        Lines( t, t, b, b ) ;
      bh :
        rArrow( t, b, t ) ;
      bl :
        rArrow( t, b, b ) ;
      bu :
        Lines( t, b, b, t ) ;
      bz :
        rArrow( t, b, m ) ;

      hb :
        lArrow( t, t, b ) ;
      hh :
        Line( t, t ) ;
      hl :
        Line( t, b ) ;
      hu :
        lArrow( t, t, b ) ;
      hz :
        Line( t, m ) ;

      lb :
        lArrow( b, t, b ) ;
      lh :
        Line( b, t ) ;
      ll :
        Line( b, b ) ;
      lu :
        lArrow( b, t, b ) ;
      lz :
        Line( b, m ) ;

      ub :
        Lines( t, b, b, t ) ;
      uh :
        rArrow( t, b, t ) ;
      ul :
        rArrow( t, b, b ) ;
      uu :
        Lines( t, t, b, b ) ;
      uz :
        rArrow( t, b, m ) ;

      zb :
        lArrow( m, t, b ) ;
      zh :
        Line( m, t ) ;
      zl :
        Line( m, b ) ;
      zu :
        lArrow( m, t, b ) ;
      zz :
        Line( m, m ) ;
    end ;
  end ;

const
  // bitmap glyph index belonging to transition between to states
  SigTrans : array [ TSLVType, TSLVType ] of TSigGlyph = (
    { ----- U   X   0   1   Z   W   L   H   D - }
    { U } ( uu, uu, ul, uh, uz, ub, ul, uh, uz ),
    { X } ( uu, uu, ul, uh, uz, ub, ul, uh, uz ),
    { 0 } ( lu, lu, ll, lh, lz, lb, ll, lh, lz ),
    { 1 } ( hu, hu, hl, hh, hz, hb, hl, hh, hz ),
    { Z } ( zu, zu, zl, zh, zz, zb, zl, zh, zz ),
    { W } ( bu, bu, bl, bh, bz, bb, bl, bh, bz ),
    { L } ( lu, lu, ll, lh, lz, lb, ll, lh, lz ),
    { H } ( hu, hu, hl, hh, hz, hb, hl, hh, hz ),
    { D } ( zu, zu, zl, zh, zz, zb, zl, zh, zz ) ) ;

begin
  Result := nil ;

  with fPaintInfo do begin
    Zoom := fViewer.fZoom ;

    iLeft := -fViewer.OffsetX ;
    iRight := iLeft + fViewer.Width - ( fViewer.fCol[ 0 ].Width + fViewer.fCol[ 1 ].Width + fViewer.fCol[ 2 ].Width ) ;
    iStart := Max( 0, Instance.IndexOf( iLeft * fs_per_pixel div Zoom ) - 1 ) ;
    iEnd := Min( Instance.IndexOf( iRight * fs_per_pixel div Zoom ) + 1, Instance.EventCount ) ;

    Canvas.Pen.Width := 1 ;
    Canvas.Pen.Color := clBlack ;
    Canvas.Brush.Color := clGreen ;
    Canvas.Brush.Style := bsClear ;

    rt := ContentRect ;
    gName := Instance.SignalType.ClassName ;
    if Instance.SignalType.BaseType is TGHWTypePhysical then begin
      Canvas.Pen.Color := clBlue ;
      for i := iStart to iEnd - 1 do begin
        with Instance.Events[ i ] do
          rt.Right := ContentRect.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom ;
        if fDrawText and ( i > 0 ) then
          Canvas.TextRect( rt, rt.Left + 2, rt.Top + 2, Instance.AsString( i - 1 ) ) ;
        Canvas.MoveTo( rt.Right, rt.Top + 2 ) ;
        Canvas.LineTo( rt.Right, rt.Bottom - 3 ) ;
        rt.Left := rt.Right ;
      end ;
      rt.Right := ContentRect.Right ;
    end
    else if Instance.SignalType.BaseType is TGHWTypeScalar then begin
      Canvas.Pen.Color := clBlue ;
      for i := iStart to iEnd - 1 do begin
        with Instance.Events[ i ] do
          rt.Right := ContentRect.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom ;
        if fDrawText and ( i > 0 ) then
          Canvas.TextRect( rt, rt.Left + 2, rt.Top + 2, Instance.AsString( i - 1 ) ) ;
        Canvas.MoveTo( rt.Right, rt.Top + 2 ) ;
        Canvas.LineTo( rt.Right, rt.Bottom - 3 ) ;
        rt.Left := rt.Right ;
      end ;
      rt.Right := ContentRect.Right ;
    end
    else if Instance.SignalType.BaseType is TGHWTypeEnum then begin
      iTypeEnum := Instance.SignalType.BaseType as TGHWTypeEnum ;
      case iTypeEnum.WKT of
        ghw_wkt_unknown : begin
            for i := iStart + 1 to iEnd - 1 do begin
              with Instance.Events[ i ] do
                rt.Right := ContentRect.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom ;
              if fDrawText and ( i > 0 ) then
                Canvas.TextRect( rt, rt.Left + 2, rt.Top + 2, Instance.AsString( i - 1 ) ) ;
              Draw( bb ) ;
              rt.Left := rt.Right - 1 ;
              rt.Right := rt.Right + Zoom ;
              Draw( bu ) ;
              rt.Left := rt.Right ;
            end ;
            rt.Right := ContentRect.Right ;
            Canvas.TextRect( rt, rt.Left + 2, rt.Top + 2, Instance.AsString( Instance.EventCount - 1 ) ) ;
            Draw( bb ) ;
          end ;

        ghw_wkt_boolean, ghw_wkt_bit : begin
            Canvas.Pen.Color := clFuchsia ;
            if Instance.Events[ iStart ].val.i64 <> 0 then
              n := slv1
            else
              n := slv0 ;
            Canvas.Pen.Color := clBlack ;

            for i := iStart + 1 to iEnd - 1 do begin
              o := n ;
              g := SigTrans[ o, n ] ;
              with Instance.Events[ i ] do begin
                rt.Right := ContentRect.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom ;
                if val.i64 <> 0 then
                  n := slv1
                else
                  n := slv0 ;
              end ;
              Draw( g ) ;
              rt.Left := rt.Right - 1 ;
              rt.Right := rt.Right + Zoom ;
              g := SigTrans[ o, n ] ;
              Draw( g ) ;
              rt.Left := rt.Right ;
            end ;
            g := SigTrans[ n, n ] ;
            rt.Right := ContentRect.Right ;
            Draw( g ) ;
          end ;

        ghw_wkt_std_ulogic : begin
            Canvas.Pen.Color := clFuchsia ;
            n := TSLVType( Instance.Events[ iStart ].val.i64 ) ;
            case n of
              slvX :
                Canvas.Pen.Color := clRed ;
              slvU :
                Canvas.Pen.Color := clFuchsia ;
              slvL, slvH, slvW :
                Canvas.Pen.Color := clBlue ;
            else
              Canvas.Pen.Color := clBlack ;
            end ;

            for i := iStart + 1 to iEnd - 1 do begin
              o := n ;
              g := SigTrans[ o, n ] ;
              with Instance.Events[ i ] do begin
                rt.Right := ContentRect.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom + 1 ;
                n := TSLVType( val.i64 ) ;
              end ;
              Draw( g ) ;

              rt.Left := rt.Right ;
              rt.Right := rt.Right + Zoom ;
              g := SigTrans[ o, n ] ;

              Draw( g ) ;
              case n of
                slvX :
                  Canvas.Pen.Color := clRed ;
                slvU :
                  Canvas.Pen.Color := clFuchsia ;
                slvL, slvH, slvW :
                  Canvas.Pen.Color := clBlue ;
              else
                Canvas.Pen.Color := clBlack ;
              end ;

              rt.Left := rt.Right ;
            end ;
            g := SigTrans[ n, n ] ;
            rt.Right := ContentRect.Right ;
            Draw( g ) ;
          end ;
      end ;
    end
  end ;

  // Cursor and Marker
  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHieSignal ) : TObject ;
begin
  Result := nil ;
  if assigned( Instance ) and assigned( Instance.Signals ) then
    Result := Instance.Signals.Accept( Self ) ;
  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHieDesign ) : TObject ;
begin
  Result := nil ;
  fViewer.PaintDelta( fPaintInfo ) ;
  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWSignalArray ) : TObject ;
var
  i, iCount : integer ;

  rt : TRect ;
  Zoom : integer ;
  iStart, iEnd : integer ;
  iLeft, iRight : int64 ;

  s : string ;

begin
  Result := nil ;
  fDrawText := false ;
  iCount := Min( Instance.Count, 32 ) ;
  for i := 0 to iCount - 1 do
    Instance.Signals[ i ].Accept( Self ) ;
  fDrawText := True ;

  iCount := Instance.EventCount ;
  if iCount <= 0 then
    Exit ;

  with fPaintInfo do begin
    Zoom := fViewer.fZoom ;

    iLeft := -fViewer.OffsetX ;
    iRight := iLeft + fViewer.Width - ( fViewer.fCol[ 0 ].Width + fViewer.fCol[ 1 ].Width + fViewer.fCol[ 2 ].Width ) ;
    iStart := Max( 0, Instance.IndexOf( iLeft * fs_per_pixel div Zoom ) - 1 ) ;
    iEnd := Min( Instance.IndexOf( iRight * fs_per_pixel div Zoom ) + 1, Instance.EventCount ) ;

    Canvas.Pen.Width := 1 ;
    Canvas.Pen.Color := clBlack ;
    Canvas.Brush.Color := clGreen ;
    Canvas.Brush.Style := bsClear ;

    rt := ContentRect ; // backup
    gName := Instance.SignalType.ClassName ;
    Canvas.Pen.Color := clBlue ;
    for i := iStart to iEnd - 1 do begin
      with Instance.Events[ i ] do
        ContentRect.Right := rt.Left + ( time div fs_per_pixel - fViewer.RangeLeft ) * Zoom ;
      ContentRect.Left := ContentRect.Left + Zoom ; // offset
      if fDrawText and ( i > 0 ) then begin
        s := Instance.AsString( i - 1 ) ;
        fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
      end ;
      ContentRect.Left := ContentRect.Right ;
    end ;
    ContentRect := rt ;
  end ;

  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWSignalRecord ) : TObject ;
var
  i, iCount : integer ;
begin
  Result := nil ;
  fDrawText := false ;
  iCount := Min( Instance.Count, 32 ) ;
  for i := 0 to iCount - 1 do
    Instance.Signals[ i ].Accept( Self ) ;
  fDrawText := True ;
  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHieGenerateIf ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHieGenerateFor ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

procedure TGHWDrawVisitor.DrawMarkers ;
begin
  with fPaintInfo do begin
    with Canvas, ContentRect do begin
      Pen.Color := clBlue ;
      MoveTo( Left + ( fViewer.Center - fViewer.RangeLeft ) * fViewer.Zoom, Top ) ;
      LineTo( Left + ( fViewer.Center - fViewer.RangeLeft ) * fViewer.Zoom, Bottom ) ;
      Pen.Color := clRed ;
      MoveTo( Left + ( fViewer.Marker - fViewer.RangeLeft ) * fViewer.Zoom, Top ) ;
      LineTo( Left + ( fViewer.Marker - fViewer.RangeLeft ) * fViewer.Zoom, Bottom ) ;
    end ;
  end ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHieInstance ) : TObject ;
begin
  Result := nil ;
  DrawMarkers ;
end ;

function TGHWDrawVisitor.Visit( Instance : TGHWHie ) : TObject ;
begin
  Result := nil ;
  DrawMarkers ;
end ;

{ TGHWPathVisitor }

function TGHWPathVisitor.Visit( Instance : TGHWHieSignal ) : TObject ;
var
  s : string ;
  iParent : TGHW ;
begin
  Result := nil ;
  s := '' ;
  iParent := Instance.Parent as TGHW ;
  while assigned( iParent ) do begin
    if iParent is TGHWHieDesign then
    else
      s := string( iParent.name ) + '/' + s ;
    iParent := iParent.Parent ;
  end ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWHie ) : TObject ;
var
  s : string ;
  iParent : TGHW ;
begin
  s := '' ;
  iParent := Instance.Parent ;
  while assigned( iParent ) do begin
    if iParent is TGHWHieDesign then
    else
      s := string( iParent.name ) + '/' + s ;
    iParent := iParent.Parent ;
  end ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
  Result := nil ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWSignal ) : TObject ;
var
  s : string ;
  iParent : TGHW ;
begin
  s := '' ;
  iParent := Instance.Parent ;
  while assigned( iParent ) do begin
    if iParent.name <> '' then
      s := string( iParent.name ) + '/' + s ;
    iParent := iParent.Parent ;
  end ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
  Result := nil ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWSignalRecord ) : TObject ;
var
  s : string ;
  iParent : TGHW ;
begin
  s := '' ;
  iParent := Instance.Parent ;
  while assigned( iParent ) do begin
    if iParent.name <> '' then
      s := string( iParent.name ) + '/' + s ;
    iParent := iParent.Parent ;
  end ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
  Result := nil ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWHieGenerateIf ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWHieGenerateFor ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWHieInstance ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWHieDesign ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWPathVisitor.Visit( Instance : TGHWSignalArray ) : TObject ;
var
  s : string ;
  iParent : TGHW ;
begin
  s := '' ;
  iParent := Instance.Parent ;
  while assigned( iParent ) do begin
    if iParent.name <> '' then
      s := string( iParent.name ) + '/' + s ;
    iParent := iParent.Parent ;
  end ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
  Result := nil ;
end ;

{ TGHWDispNameVisitor }

function TGHWNameVisitor.Visit( Instance : TGHWHieSignal ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWHie ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWSignal ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWSignalRecord ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWHieGenerateIf ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWHieGenerateFor ) : TObject ;
begin
  Result := Visit( TGHWHie( Instance ) ) ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWHieInstance ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWHieDesign ) : TObject ;
var
  s : string ;
begin
  with fPaintInfo, ContentRect do
    s := MinimizeName( Instance.DisplayName, Canvas, Right - Left ) ; ;
  fViewer.PaintNormalText( fPaintInfo, 0, s ) ;
  Result := nil ;
end ;

function TGHWNameVisitor.Visit( Instance : TGHWSignalArray ) : TObject ;
begin
  fViewer.PaintNormalText( fPaintInfo, 0, Instance.DisplayName ) ;
  Result := nil ;
end ;

{ TGHWValueVisitor }

function TGHWValueVisitor.Visit( Instance : TGHWHieSignal ) : TObject ;
begin
  Result := nil ;
  if assigned( Instance ) and assigned( Instance.Signals ) then
    Result := Instance.Signals.Accept( Self ) ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWHieDesign ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, IntToStr( Marker - Center ) ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWSignal ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, Instance.AsString( ( Center - 1 ) * fs_per_pixel ) ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWSignalRecord ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, Instance.AsString( ( Center ) * fs_per_pixel ) ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWHieGenerateIf ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, '{if true}' ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWHieGenerateFor ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, '{' + Format( 'iter: %d', [ Instance.Block.iter_value.i64 ] ) + '}' ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWHieInstance ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, '{' + Instance.DisplayName + '}' ) ;
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWHie ) : TObject ;
begin
  Result := nil ;
end ;

function TGHWValueVisitor.Visit( Instance : TGHWSignalArray ) : TObject ;
begin
  with fViewer do
    PaintNormalText( fPaintInfo, 0, Instance.AsString( ( Center ) * fs_per_pixel ) ) ;
  Result := nil ;
end ;

end.
